home *** CD-ROM | disk | FTP | other *** search
/ Aminet 7 / Aminet 7 - August 1995.iso / Aminet / comm / bbs / WWBBSDoors.lha / WWBBS / rexxDoors / Polling_Place.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-04-27  |  10.0 KB  |  463 lines
  1. /* $VER: Polling_Place.rexx 6.2 (5.8.93)
  2.  a Voting Booth for BBBBS by Richard Lee Stockton
  3. */
  4.  
  5. options results
  6.  
  7. CALL TIME('R')
  8. SIGNAL ON BREAK_C
  9. SIGNAL ON BREAK_E
  10. CR='0D'x
  11.  
  12. BBSIDENTIFY SYSOP
  13. sysop=result
  14. bbsname='WWBBS'
  15.  
  16. bbspath=GETCLIP('BBS_path')
  17. polldir=bbspath'rexxDoors/Data/Polls'
  18. CALL MAKEDIR(polldir)
  19.  
  20. PARSE ARG name . . colorflag secs .
  21.  
  22. BBSIDENTIFY EMULATION
  23. PARSE VAR RESULT type .
  24. if type = "ANSI" then
  25.   colorflag=1
  26. else
  27.   colorflag=0
  28.  
  29. BBSIDENTIFY USER
  30. PARSE VAR RESULT Username From Acces .
  31. name = substr(Username,2,length(Username)-2)
  32.  
  33. CALL colors(colorflag)
  34. polls=SHOWDIR(polldir)
  35.  
  36. DO FOREVER
  37.   SAY CR
  38.   SAY bak2||CENTER('  -  Polling_Place.rexx  version 6.2  5 Aug 1993  -  ',75)||def||CR
  39.   CALL ShowPolls()
  40.   com=getinput(1 0 '['pen3'Q'def']uit_To_BBS, ['pen3'S'def']tart_New_Poll or Select_Poll_Number > ')
  41.   com=STRIP(com)
  42.   CALL checkBBS()
  43.   SELECT
  44.     WHEN com='S' THEN CALL InitPoll()
  45.     WHEN com='X' | com='Q' THEN
  46.       DO
  47.         SAY CR
  48.         SAY 'Returning to the BBS...'CR
  49.         SAY CR
  50.         EXIT
  51.       END
  52.     WHEN DATATYPE(com,'N') THEN CALL do_poll()
  53.     WHEN com='' THEN
  54.       IF getinput(1 1 'Return to BBS? (nY) > ')~='N' THEN EXIT
  55.     OTHERWISE NOP
  56.   END
  57. END
  58. EXIT
  59.  
  60.  
  61. checkBBS:
  62. IF ADDRESS()~='BAUD' THEN RETURN 0
  63. IF TIME('E')>secs THEN EXIT
  64. dcd
  65. IF RC=0 THEN EXIT
  66. temp=secs-TIME('E')
  67. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
  68. RETURN 0
  69.  
  70.  
  71. getinput:
  72. PARSE ARG upflag' 'oneflag' 'pline
  73. prompt( pline)
  74. inarg=readstr()
  75. inarg=STRIP(inarg)
  76. IF upflag THEN inarg=UPPER(inarg)
  77. IF oneflag THEN inarg=LEFT(inarg,1)
  78. inarg=cleanstring(0':'inarg)
  79. IF LENGTH(inarg)>64 THEN
  80.   DO
  81.     SAY 'Question too long!  Please try again.'CR
  82.     inarg=getinput(0 0 pline)
  83.   END
  84. RETURN inarg
  85.  
  86.  
  87. cleanstring:
  88. PARSE ARG nflag':'cstr
  89. bot=TRIM(XRANGE(,' '))
  90. bot=COMPRESS(bot,'1B'x)
  91. top=XRANGE('7F'x)
  92. IF nflag=1 THEN
  93.   DO
  94.     bot=bot||XRANGE('!','@')'[\]`~{:}'
  95.     cstr=TRANSLATE(UPPER(cstr),' ','_')
  96.   END
  97. cstr=COMPRESS(cstr,bot||top)
  98. IF nflag~=2 THEN cstr=STRIP(cstr)
  99. IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
  100. RETURN cstr
  101.  
  102.  
  103. ShowPolls:
  104. SAY CR
  105. totpolls=WORDS(polls)
  106. DO pfl=1 TO totpolls BY 3
  107.   pfl2=pfl+1
  108.   pfl3=pfl+2
  109.   pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(polls,pfl),21)
  110.   IF pfl2<=totpolls THEN
  111.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(polls,pfl2),21)
  112.   IF pfl3<=totpolls THEN
  113.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(polls,pfl3),21)
  114.   SAY pfline||CR
  115. END
  116. SAY LEFT('=',75,'=')||CR
  117. RETURN
  118.  
  119.  
  120. InitPoll:
  121. SAY CR
  122. SAY 'You are now starting a new list of questions to be answered by other'CR
  123. SAY 'users. You may enter as many multiple-choice questions as you like.'CR
  124. SAY 'You should limit the number of answers per question to 10 or less.'CR
  125. SAY 'Other than that, you are limited only by the bounds of good taste.'CR
  126. SAY 'A ''None Of The Above'' entry will be added to each list of answers.'CR
  127. SAY 'For a simple Yes/No or True/False question just enter one answer (Yes,'CR
  128. SAY 'No, True, False), and the opposite answer will be filled in for you.'CR
  129. SAY CR
  130. u.=''
  131. u.0=0
  132. p.=''
  133. p.0=0
  134. p.0.0=3
  135. n=LASTPOS('_',name)
  136. p.0.0.0='The_'SUBSTR(name,n+1)'_Poll'
  137. DO i=2 WHILE EXISTS(polldir'/'p.0.0.0)
  138.   p.0.0.0=p.0.0.0'_'i
  139. END
  140. p.0.0.0=STRIP(RIGHT(p.0.0.0,20))
  141. p.0.1=DATE('I')
  142. p.0.1.0=name
  143. p.0.2=0
  144. p.0.2.0=p.0.1
  145. p.0.3=0
  146. p.0.3.0=p.0.1
  147. DO i=1
  148.   DO ii=1
  149.     CALL checkBBS()
  150.     SAY CR
  151.     SAY 'Enter Question Number' i '  (or blank to quit)'CR
  152.     SAY '  'LEFT('=',64,'=')||CR
  153.     t=getinput(0 0 '> ')
  154.     IF t='' THEN LEAVE i
  155.     SAY t||CR
  156.     IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE ii
  157.   END
  158.   p.i.0.0=t
  159.   DO j=1
  160.     DO jj=1
  161.       SAY 'Enter Answer Number' j '  (or blank to quit)'CR
  162.       t=getinput(0 0 '> ')
  163.       IF t='' THEN LEAVE j
  164.       SAY t||CR
  165.       IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE jj
  166.     END
  167.     p.i.j=0
  168.     p.i.j.0=t
  169.   END
  170.   IF j=1 THEN
  171.     DO
  172.       p.i.0=''
  173.       p.i.0.0=''
  174.       LEAVE i
  175.     END
  176.   ELSE IF j=2 THEN
  177.     DO
  178.       IF UPPER(p.i.1.0)='NO' THEN line='Yes'
  179.       ELSE IF UPPER(p.i.1.0)='YES' THEN line='No'
  180.       ELSE IF UPPER(p.i.1.0)='TRUE' THEN line='False'
  181.       ELSE IF UPPER(p.i.1.0)='FALSE' THEN line='True'
  182.       ELSE line='None of the above.'
  183.     END
  184.   ELSE IF j>2 THEN
  185.     DO
  186.       jj=j-1
  187.       IF LEFT(UPPER(p.i.jj),17)='NONE OF THE ABOVE' THEN j=j-1
  188.       line='None of the above.'
  189.     END
  190.   p.i.0=j
  191.   p.i.j=0
  192.   p.i.j.0=line
  193. END
  194. i=i-1
  195. IF i<1 THEN
  196.   DO
  197.     p.=''
  198.     RETURN 1
  199.   END
  200. p.0=i
  201. SAY CR
  202. SAY 'This group of questions is currently called' p.0.0.0||CR
  203. IF getinput(1 1 pen3'Is that correct? (nY) > 'def)='N' THEN
  204.   DO
  205.     SAY 'Please enter a Title, 20 characters or less.'CR
  206.     SAY pen3'  'LEFT('=',20,'=')||def||CR
  207.     t=getinput(0 0 '> ')
  208.     t=COMPRESS(t,xrange(,d2c(31))':/;,`?*='xrange('{')||d2c(34))
  209.     IF t='' THEN t=p.0.0.0
  210.     t=TRANSLATE(t,'_',' ')
  211.     p.0.0.0=t
  212.   END
  213. poll=STRIP(LEFT(p.0.0.0,20))
  214. CALL WritePoll(poll)
  215. polls=SHOWDIR(polldir)
  216. RETURN 0
  217.  
  218.  
  219. do_poll:
  220. IF com<1 | com>WORDS(polls) THEN RETURN
  221. poll=STRIP(WORD(polls,com))
  222. CALL ReadPoll(poll)
  223. IF voted=0 THEN CALL vote()
  224. IF stats() THEN CALL WritePoll(poll)
  225. RETURN
  226.  
  227.  
  228. ReadPoll:
  229. PARSE ARG filename .
  230. CALL CLOSE(f)
  231. x=OPEN(f,polldir'/'filename,'R')
  232. IF x=0 THEN RETURN 1
  233. p.=''
  234. p.0=READLN(f)
  235. IF ~DATATYPE(p.0,'N') THEN RETURN 2
  236. i=0
  237. j=0
  238. DO loop=1
  239.   line=READLN(f)
  240.   IF EOF(f) THEN LEAVE loop
  241.   IF LEFT(line,3)='@@@' THEN
  242.     DO
  243.       IF WORD(line,2)='VOTED' THEN LEAVE loop
  244.       i=i+1
  245.       j=0
  246.       ITERATE loop
  247.     END
  248.   p.i.j=line
  249.   p.i.j.0=READLN(f)
  250.   j=j+1
  251. END
  252. voted=0
  253. u.=''
  254. DO loop=1
  255.   line=READLN(f)
  256.   IF EOF(f) THEN LEAVE loop
  257.   IF name=STRIP(line) THEN voted=1
  258.   u.loop=line
  259. END
  260. CALL CLOSE(f)
  261. IF voted=0 THEN
  262.   DO
  263.     u.0=loop
  264.     u.loop=name
  265.   END
  266. ELSE u.0=loop-1
  267. RETURN 0
  268.  
  269.  
  270. vote:
  271. SAY poll||CR
  272. DO i=1 TO p.0
  273.   SAY pen3'Question:'def p.i.0.0||CR
  274.   IF p.i.0<16 THEN
  275.     DO j=1 TO p.i.0
  276.       SAY pen3||RIGHT(j,7)||def p.i.j.0||CR
  277.     END
  278.   ELSE
  279.     DO pfl=1 TO p.i.0 BY 3
  280.       pfl2=pfl+1
  281.       pfl3=pfl+2
  282.       pfline=pen3||RIGHT(pfl,3)||def LEFT(p.i.pfl.0,21)
  283.       IF pfl2<=p.i.0 THEN
  284.         pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(p.i.pfl2.0,21)
  285.       IF pfl3<=p.i.0 THEN
  286.         pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(p.i.pfl3.0,21)
  287.       SAY pfline||CR
  288.     END
  289.   j=''
  290.   DO WHILE ~DATATYPE(j,'N')
  291.     CALL checkBBS()
  292.     j=getinput(1 0 'Please Select One > ')
  293.     IF j<1 | j>p.i.0 THEN j=''
  294.   END
  295.   p.i.j=p.i.j+1
  296. END
  297. p.0.2=p.0.2+1
  298. p.0.2.0=DATE('I')
  299. RETURN
  300.  
  301.  
  302. stats:
  303. p.0.3=p.0.3+1
  304. p.0.3.0=DATE('I')
  305. SAY CR
  306. SAY CR
  307. SAY pen3'Title:'def poll||CR
  308. SAY CR
  309. temp=p.0.2
  310. IF temp<1 THEN temp=1
  311. DO i=1 TO p.0
  312.   SAY p.i.0.0||CR
  313.   IF p.i.0<16 THEN
  314.     DO j=1 TO p.i.0
  315.       SAY RIGHT(TRUNC(.05+(p.i.j*100)/temp,1),6)'%  'p.i.j.0||CR
  316.     END
  317.   ELSE
  318.     DO pfl=1 TO p.i.0 BY 3
  319.       pfl2=pfl+1
  320.       pfl3=pfl+2
  321.       pfline=RIGHT(TRUNC(.05+(p.i.pfl*100)/temp,1),4)'% 'LEFT(p.i.pfl.0,19)
  322.       IF pfl2<=p.i.0 THEN
  323.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl2*100)/temp,1),4)'% 'LEFT(p.i.pfl2.0,19)
  324.       IF pfl3<=p.i.0 THEN
  325.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl3*100)/temp,1),4)'% 'LEFT(p.i.pfl3.0,19)
  326.       SAY pfline||CR
  327.     END
  328.   SAY CR
  329.   CALL getinput(1 1 'Press Return ')
  330.   SAY lineup'                      'lineup||CR
  331. END
  332. SAY poll 'originated by' p.0.1.0 DATE(,p.0.1,'I')||CR
  333. SAY 'This survey has been running' 1+DATE('I')-p.0.1 'days.'CR
  334. SAY p.0.2 'users have responded and the statistics have been read' p.0.3 'times.'CR
  335. SAY CR
  336. IF name=p.0.1.0 | name=sysop THEN
  337.   DO
  338.     temp=''
  339.     IF name=p.0.1.0 THEN temp='This one owned by you. '
  340.     temp=temp'Do you want to delete this poll? (Ny) > '
  341.     IF getinput(1 1 temp)='Y' THEN
  342.       DO
  343.         CALL bbsNewFile.rexx(name polldir'/'p.0.0.0)
  344.         CALL DELETE(polldir'/'p.0.0.0)
  345.         SAY p.0.0.0 'deleted.'CR
  346.         SAY CR
  347.         polls=SHOWDIR(polldir)
  348.         RETURN 0
  349.       END
  350.     SAY CR
  351.   END
  352. ELSE CALL getinput(1 1 'Press Return ')
  353. RETURN 1
  354.  
  355.  
  356. WritePoll:
  357. PARSE ARG filename .
  358. CALL CLOSE(f)
  359. x=OPEN(f,polldir'/'filename,'W')
  360. IF x=0 THEN RETURN 1
  361. DO i=0 TO p.0
  362.   IF i=0 THEN CALL WRITELN(f,p.0)
  363.   ELSE CALL WRITELN(f,'@@@' i)
  364.   DO j=0 TO p.i.0
  365.     CALL WRITELN(f,p.i.j)
  366.     CALL WRITELN(f,STRIP(p.i.j.0))
  367.   END
  368. END
  369. CALL WRITELN(f,'@@@ VOTED')
  370. IF ~DATATYPE(u.0,'N') THEN u.0=0
  371. DO i=1 TO u.0
  372.   CALL WRITELN(f,u.i)
  373. END
  374. CALL CLOSE(f)
  375. RETURN 0
  376.  
  377.  
  378. colors:
  379. ARG onoff
  380. IF onoff THEN
  381.   DO
  382.     lineup='1B'x'M'
  383.     def='';  /* default */
  384.     pen0='';  pen1='';  pen2='';  pen3=''
  385.     pen4='';  pen5='';  pen6='';  pen7=''
  386.     bak0='';  bak1='';  bak2='';  bak3=''
  387.     bak4='';  bak5='';  bak6='';  bak7=''
  388.   END
  389. ELSE
  390.   DO
  391.     pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
  392.     bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  393.     def='';  lineup=''
  394.   END
  395. RETURN
  396.  
  397. readstr: procedure
  398. str=''
  399. out=readch(STDIN)
  400.  call WRITECH(STDOUT,out)
  401.  do while out~=D2C(13)
  402.       if out=D2C(8) then do
  403.          str=SUBSTR(str,1,LENGTH(str)-1)
  404.          call WRITECH(STDOUT,' ')
  405.          call WRITECH(STDOUT,out)
  406.          end
  407.       else
  408.          str=INSERT(str,out)
  409.       out=readch(STDIN)
  410.       call WRITECH(STDOUT,out)
  411.     end
  412. say '0D'x
  413. return(UPPER(str))
  414.  
  415. prompt: procedure
  416. parse arg str
  417. writech(STDOUT,str)
  418. return 1
  419.  
  420. BREAK_C:
  421. BREAK_E:
  422. CALL CLOSE(f)
  423. EXIT
  424.  
  425.  
  426. /*
  427. Data Format  (Dates in internal format)
  428.  
  429. p.0        Total Questions in this survey
  430. p.0.0      "3"
  431. p.0.0.0    Overall Survey Title (also filename)
  432. p.0.1      Date this survey started.
  433. p.0.1.0    Survey Originated By
  434. p.0.2      Total users polled in this survey.
  435. p.0.2.0    Date the last user was polled in this survey.
  436. p.0.3      Total users reading responses to this survey.
  437. p.0.3.0    Date the last user read responses to this survey.
  438. "@@@ 1"
  439. p.1.0      Total possible responses to Question 1
  440. p.1.0.0    Question 1
  441. p.1.1      Response 1 Total
  442. p.1.1.0    Response 1 Text
  443. p.1.2      Response 2 Total
  444. p.1.2.0    Response 2 Text
  445. ...
  446. p.1.n      Response n-3 Total
  447. p.1.n.0    Response n-3 Text
  448. "@@@ 2"
  449. p.2.0      Total possible responses to Question 2
  450. p.2.0.0    Question 2
  451. p.2.1      Response 1 Total
  452. p.2.1.0    Response 1 Text
  453. p.2.2      Response 2 Total
  454. p.2.2.0    Response 2 Text
  455.        etc.
  456. "@@@ VOTED"
  457. u.1        first user polled
  458. ...        list of users who have responded to this survey.
  459. u.[p.0.2]  last user polled
  460. */
  461.  
  462. /* Polling_Place.rexx */
  463.